home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 44 / PC Actual CD 44.iso / Linux / Cygwin / full.exe / Disk1 / data1.cab / Tools / share / tcl8.0 / word.tcl < prev   
Encoding:
Text File  |  1998-12-04  |  4.4 KB  |  137 lines
  1. # word.tcl --
  2. #
  3. # This file defines various procedures for computing word boundaries
  4. # in strings.  This file is primarily needed so Tk text and entry
  5. # widgets behave properly for different platforms.
  6. #
  7. # Copyright (c) 1996 by Sun Microsystems, Inc.
  8. #
  9. # See the file "license.terms" for information on usage and redistribution
  10. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  11. # 
  12. # SCCS: @(#) word.tcl 1.2 96/11/20 14:07:22
  13. # 
  14. # See the file "license.terms" for information on usage and redistribution
  15. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  16. #
  17.  
  18. # The following variables are used to determine which characters are
  19. # interpreted as white space.  
  20.  
  21. # CYGNUS local: Always use Motif-style selection
  22. #if {$tcl_platform(platform) == "windows"} {
  23.     # Windows style - any but space, tab, or newline
  24. #    set tcl_wordchars "\[^ \t\n\]"
  25. #    set tcl_nonwordchars "\[ \t\n\]"
  26. #} else {
  27.     # Motif style - any number, letter, or underscore
  28.     set tcl_wordchars {[a-zA-Z0-9_]}
  29.     set tcl_nonwordchars {[^a-zA-Z0-9_]}
  30. #}
  31.  
  32. # tcl_wordBreakAfter --
  33. #
  34. # This procedure returns the index of the first word boundary
  35. # after the starting point in the given string, or -1 if there
  36. # are no more boundaries in the given string.  The index returned refers
  37. # to the first character of the pair that comprises a boundary.
  38. #
  39. # Arguments:
  40. # str -        String to search.
  41. # start -    Index into string specifying starting point.
  42.  
  43. proc tcl_wordBreakAfter {str start} {
  44.     global tcl_nonwordchars tcl_wordchars
  45.     set str [string range $str $start end]
  46.     if [regexp -indices "$tcl_wordchars$tcl_nonwordchars|$tcl_nonwordchars$tcl_wordchars" $str result] {
  47.     return [expr [lindex $result 1] + $start]
  48.     }
  49.     return -1
  50. }
  51.  
  52. # tcl_wordBreakBefore --
  53. #
  54. # This procedure returns the index of the first word boundary
  55. # before the starting point in the given string, or -1 if there
  56. # are no more boundaries in the given string.  The index returned
  57. # refers to the second character of the pair that comprises a boundary.
  58. #
  59. # Arguments:
  60. # str -        String to search.
  61. # start -    Index into string specifying starting point.
  62.  
  63. proc tcl_wordBreakBefore {str start} {
  64.     global tcl_nonwordchars tcl_wordchars
  65.     if {[string compare $start end] == 0} {
  66.     set start [string length $str]
  67.     }
  68.     if [regexp -indices "^.*($tcl_wordchars$tcl_nonwordchars|$tcl_nonwordchars$tcl_wordchars)" [string range $str 0 $start] result] {
  69.     return [lindex $result 1]
  70.     }
  71.     return -1
  72. }
  73.  
  74. # tcl_endOfWord --
  75. #
  76. # This procedure returns the index of the first end-of-word location
  77. # after a starting index in the given string.  An end-of-word location
  78. # is defined to be the first whitespace character following the first
  79. # non-whitespace character after the starting point.  Returns -1 if
  80. # there are no more words after the starting point.
  81. #
  82. # Arguments:
  83. # str -        String to search.
  84. # start -    Index into string specifying starting point.
  85.  
  86. proc tcl_endOfWord {str start} {
  87.     global tcl_nonwordchars tcl_wordchars
  88.     if [regexp -indices "$tcl_nonwordchars*$tcl_wordchars+$tcl_nonwordchars" \
  89.         [string range $str $start end] result] {
  90.     return [expr [lindex $result 1] + $start]
  91.     }
  92.     return -1
  93. }
  94.  
  95. # tcl_startOfNextWord --
  96. #
  97. # This procedure returns the index of the first start-of-word location
  98. # after a starting index in the given string.  A start-of-word
  99. # location is defined to be a non-whitespace character following a
  100. # whitespace character.  Returns -1 if there are no more start-of-word
  101. # locations after the starting point.
  102. #
  103. # Arguments:
  104. # str -        String to search.
  105. # start -    Index into string specifying starting point.
  106.  
  107. proc tcl_startOfNextWord {str start} {
  108.     global tcl_nonwordchars tcl_wordchars
  109.     if [regexp -indices "$tcl_wordchars*$tcl_nonwordchars+$tcl_wordchars" \
  110.         [string range $str $start end] result] {
  111.     return [expr [lindex $result 1] + $start]
  112.     }
  113.     return -1
  114. }
  115.  
  116. # tcl_startOfPreviousWord --
  117. #
  118. # This procedure returns the index of the first start-of-word location
  119. # before a starting index in the given string.
  120. #
  121. # Arguments:
  122. # str -        String to search.
  123. # start -    Index into string specifying starting point.
  124.  
  125. proc tcl_startOfPreviousWord {str start} {
  126.     global tcl_nonwordchars tcl_wordchars
  127.     if {[string compare $start end] == 0} {
  128.     set start [string length $str]
  129.     }
  130.     if [regexp -indices \
  131.         "$tcl_nonwordchars*($tcl_wordchars+)$tcl_nonwordchars*\$" \
  132.         [string range $str 0 [expr $start - 1]] result word] {
  133.     return [lindex $word 0]
  134.     }
  135.     return -1
  136. }
  137.